home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Taifun / Taifun 143 (1990-08-15)(Ossowski, Stefan)(DE)(PD).zip / Taifun 143 (1990-08-15)(Ossowski, Stefan)(DE)(PD).adf / SASTools / Vibrator / Vibrator.mod < prev    next >
Text File  |  1990-05-16  |  4KB  |  95 lines
  1. (***************************************************************************
  2. *  Programme : Vibrator.mod                                                *
  3. *  Usage     : Vibrator                                                    *
  4. *  Version   : V2.30                                                       *
  5. *  Date      : 29.03.1989                                                  *
  6. *  Author    : Jörg Sixt                                                   *
  7. *  Purpose   : start it and you'll see there's none                        *
  8. *  Language  : Modula-2,AMSoft  PD-Version from Fish 113                   *
  9. *  Bugs      : none known                                                  *
  10. ***************************************************************************)
  11.  
  12. MODULE Vibrator ;
  13.  
  14. FROM SYSTEM    IMPORT ADR ;
  15. FROM Exec      IMPORT GetMsg,ReplyMsg;
  16. FROM Intuition IMPORT NewWindow,WindowPtr,OpenWindow,CloseWindow,ScreenFlags,
  17.                       ScreenFlagSet,IDCMPFlags,IDCMPFlagSet,WindowFlags,
  18.                       WindowFlagSet,IntuiMessagePtr,RemakeDisplay,ViewAddress,
  19.                       CurrentTime,DisplayAlert ;
  20. FROM Graphics  IMPORT ViewPtr ;
  21. FROM Dos       IMPORT Delay ;
  22.  
  23. CONST
  24.     DeltaTime           =  1 ; (* Time in ticks between two movements *)
  25.     DeltaX              =  5 ; (* X-deflection *)
  26.     DeltaY              =  5 ; (* Y-deflection *)
  27.  
  28. VAR
  29.     NewWin              : NewWindow ;
  30.     GagWinPtr           : WindowPtr ;
  31.     WhatPtr             : IntuiMessagePtr ;
  32.     GagView             : ViewPtr ;
  33.     oldX,oldY,help      : INTEGER ;
  34.     secPtr,micPtr       : POINTER TO LONGCARD ;
  35.     PowerLED [12574721] : CHAR ;
  36.     Guru : RECORD
  37.        Xpos : CARDINAL ;
  38.        Text : ARRAY [0..59] OF CHAR ;
  39.     END ;
  40.  
  41. BEGIN
  42.    WITH Guru DO
  43.       Text := "?Vibration over and over again by  sick amiga softwäre !!!" ;
  44.       Xpos := 84 ; Text[0] := CHR(20) ; Text[59] := CHR(0) ;
  45.    END ;
  46.    WITH NewWin DO
  47.       leftEdge    :=   0 ; topEdge   :=   0 ;
  48.       width       := 500 ; height    :=  10 ;
  49.       detailPen   := 255 ; blockPen  := 255 ;
  50.       idcmpFlags  := IDCMPFlagSet  {closeWindow} ;
  51.       flags       := WindowFlagSet {windowClose,activate,windowRefresh} ;
  52.       firstGadget := NIL ; checkMark := NIL ;
  53.       title       := ADR("Shiverbench release 2.3.     0000000 free memory") ;
  54.       screen      := NIL ; bitMap    := NIL ;
  55.       type        := ScreenFlagSet {wbenchScreen} ;
  56.    END ;
  57.    GagWinPtr := OpenWindow (NewWin) ; IF (GagWinPtr = NIL) THEN HALT ; END ;
  58.    GagView   := ViewAddress() ;
  59.    oldX      := GagView^.dxOffset ;
  60.    oldY      := GagView^.dyOffset ;
  61.    LOOP
  62.       WhatPtr := GetMsg (GagWinPtr^.userPort) ;
  63.       IF (WhatPtr <> NIL) THEN EXIT ; END ;
  64.       CurrentTime (secPtr,micPtr) ;
  65.       IF ODD(micPtr^) THEN
  66.          IF (GagView^.dyOffset = oldY) THEN
  67.              GagView^.dyOffset:= oldY + DeltaY ;
  68.          ELSE
  69.              GagView^.dyOffset:= oldY ;
  70.          END ;
  71.       ELSE
  72.          IF (GagView^.dxOffset = oldX) THEN
  73.              GagView^.dxOffset:= oldX +DeltaX ;
  74.          ELSE
  75.              GagView^.dxOffset:= oldX ;
  76.          END ;
  77.       END ;
  78.       RemakeDisplay ;
  79.       Delay (DeltaTime) ;
  80.       IF (PowerLED = 374C) THEN
  81.           PowerLED:= 376C ;
  82.       ELSE
  83.           PowerLED:= 374C ;
  84.       END ;
  85.    END ;
  86.    ReplyMsg (WhatPtr) ;
  87.    GagView^.dxOffset := oldX ;
  88.    GagView^.dyOffset := oldY ;
  89.    RemakeDisplay ;
  90.    IF DisplayAlert (0,ADR(Guru),35) THEN END ; (* trick to avoid a variable *)
  91.    PowerLED := 374C ;
  92.    CloseWindow (GagWinPtr) ;
  93. END Vibrator .
  94.  
  95.